perm filename MIXSCR.F4[SCR,MUS] blob
sn#544853 filedate 1980-11-10 generic text, type T, neo UTF8
C***** MIXES AND LINKS FILES PUT OUT BY 'SCORE' *******
C***** ALL FILES MUST HAVE THE .SCR EXTENSION *****
C***** LOAD WITH SPRINT.FAI (DON'T WORRY ABOUT SOME UNDEF. GLOBALS.)
C***** MAYBE USE 'R LOADER'. INCLUDE '/LLIB40.OLD[1,3]'. OTHERWISE THERE
C WILL BE READ ERRORS DUE TO BUGS IN CURRENT LIB40 3/77 *******
COMMON /VV/KL,N1,N2,N3,J,K,L,M,P1,PX,A,B,C,D,IBL
COMMON /LNK/ NK,NZ(20),IP /QQQ/QQQ(144) /RRR/RRR(144)
DIMENSION Q(18)
EQUIVALENCE (Q,QQQ)
DATA IBL/' '/
TYPE 24
NK=0
LX=0
ACCEPT 2,K,IP
CALL LO2UP(K)
CALL LO2UP(IP)
IF(K.EQ.'L')LX=-1
200 TYPE 20
ACCEPT 2,N1
IF(N1.EQ.IBL)GO TO 200
CALL LO2UP(N1)
201 TYPE 22
ACCEPT 2,N2
CALL LO2UP(N2)
COPEN IF(N2.EQ.IBL.OR.N2.EQ.N1)GO TO 201
IF(LX.EQ.0)GO TO 202
1000 TYPE 41
ACCEPT 2,K
IF(K.EQ.IBL)GO TO 202
CALL LO2UP(K)
C TAKES UP TO 2+10 FILES.
NK=NK+1
NZ(NK)=K
IF(NK.LT.20)GO TO 1000
202 TYPE 123
ACCEPT 124,DELAY
2001 TYPE 23
ACCEPT 2,N3
CALL LO2UP(N3)
IF(N3.NE.IBL.AND.N3.NE.N1.AND.N3.NE.N2)GO TO 2000
TYPE 2002
GO TO 2001
2002 FORMAT(' USE DIFFERENT NAME FOR OUTPUT.')
2000 CALL OPENIT(1,N3,'SCR',1)
CALL OPENIT(21,N1,'SCR',0)
CALL OPENIT(22,N2,'SCR',0)
C CALL OPENIT(A,B,C,D) D=0=INPUT D=1=OUTPUT
TYPE 25
IF(LX.EQ.0)GO TO 25
CALL LINK
GO TO 204
25 FORMAT(/' WORKING'/)
DO 1 K=1,3
READ(21,2)Q
WRITE(1,2)Q
1 READ(22,2)Q
C READS FIRST 3 LINES
CALL CHECK(N,QQQ,P1,21)
CALL CHECK(M,RRR,PX,22)
PX=PX+DELAY
CATCHES INSERTED LINES.
6 IF(PX.LT.P1)GO TO 5
CALL RDWRT(N,P1,QQQ,21)
IF(KL)10,6,6
5 CALL RDWRT(M,PX,RRR,22)
PX=PX+DELAY
IF(KL.EQ.0)GO TO 6
11 PX=10000
GO TO 13
10 P1=10000
13 IF(P1.NE.10000.OR.M.NE.N)GO TO 6
12 WRITE(1,7)
204 END FILE 1
TYPE 203,N3
CALL EXIT
203 FORMAT(/' ****** MIX FILE NAME = ',A5,'.SCR',/
1 ' ****** THIS FILE MAY NEED EDITING.')
2 FORMAT(18A5)
7 FORMAT(' FINISH;')
24 FORMAT(' MIXES OR LINKS SCORE LISTS.'/
1' USES ".SCR" EXTENSIONS ONLY!!! '/
1' BE SURE ALL HIGHER PARAMS PRINT EACH TIME.'
1//' L = LINK, <CR> = MIX '$)
41 FORMAT(' TYPE NEXT FILE NAME OR <CR> '$)
20 FORMAT(' TYPE FILE 1 (WITHOUT EXT.) '$)
22 FORMAT(/' TYPE FILE 2 '$)
23 FORMAT(/' TYPE OUTPUT NAME '$)
123 FORMAT(' DELAY TIME = '$)
124 FORMAT(F)
END
SUBROUTINE CHECK(N,Z,P1,J)
COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P,PX,LL,K,IBL
1 /QQQ/QQQ(144)
DIMENSION AA(50),Z(144)
DATA J1/7/,J2/12/,J3/21/
C J1,J2,J3 ARE POINTERS TO POS. OF DOTS IN P1,P2
KL=0
33 READ(J,30,END=100)Z
IF(Z(J1).NE.' ')GO TO 32
IF(Z(J2).NE.'.')GO TO 32
IF(Z(J3).EQ.'.')GO TO 31
CATCHES INSERTED LINES.
32 IF(Z(2).NE.'F')GO TO 300
IF(Z(3).NE.'I')GO TO 300
IF(Z(4).NE.'N')GO TO 300
IF(Z(5).NE.'I')GO TO 300
IF(Z(6).NE.'S')GO TO 300
KL=-1
N='FINIS'
300 CALL SHORT(Z)
IF(KL)RETURN
GO TO 33
100 PAUSE 'DIED IN SUBR CHECK'
31 REREAD 4,L,N,P1
30 FORMAT(144A1)
4 FORMAT(A1,A5,F)
44 FORMAT(A1,20A5)
END
SUBROUTINE SHORT(QQQ)
COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P,PX,LL,K,A,B,IBL
COMMON /LNK/ NK,NZ(20),IP
DIMENSION QQQ(1)
DO 1 K=144,1,-1
1 IF(QQQ(K).NE.' ')GO TO 2
2 IF(IP.NE.IBL)TYPE 44,(QQQ(LL),LL=1,K)
IF(KL)RETURN
3 WRITE(1,44)(QQQ(LL),LL=1,K)
44 FORMAT(144A1)
END
SUBROUTINE RDWRT(I,P,Z,J)
COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P1,PX,LL,K,IBL
DIMENSION Z(144)
KL=0
DO 3 K=144,1,-1
3 IF(Z(K).NE.' ')GO TO 4
4 IF(J.NE.22)GO TO 40
WRITE(1,41)(Z(N),N=1,6),P,(Z(N),N=16,K)
GO TO 1
40 WRITE(1,44)(Z(N),N=1,K)
1 READ (J,44,END=100)Z
DO 5 K=144,1,-1
5 IF(Z(K).NE.' ')GO TO 6
6 WRITE(1,44)(Z(N),N=1,K)
IF(Z(1).NE.';')GO TO 1
IF(Z(2).NE.'P')GO TO 1
IF(Z(3).NE.'R')GO TO 1
IF(Z(4).NE.'I')GO TO 1
IF(Z(5).NE.'N')GO TO 1
IF(Z(6).NE.'T')GO TO 1
2 CALL CHECK(I,Z,P,J)
RETURN
44 FORMAT(144A1)
41 FORMAT(6A1,F9.3,137A1)
100 PAUSE 'DIED IN SUBR RDWRT - INPUT FILE FORMAT INCORRECT'
END
SUBROUTINE LINK
COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P1,PX,LL,K,IBL
COMMON /LNK/ NK,NZ(20),IP /QQQ/QQQ(144)
44 FORMAT(144A1)
KL=0
JJ=0
J=21
1 READ(J,44)QQQ
32 IF(QQQ(2).NE.'F')GO TO 4
IF(QQQ(3).NE.'I')GO TO 4
IF(QQQ(4).NE.'N')GO TO 4
IF(QQQ(5).NE.'I')GO TO 4
IF(QQQ(6).NE.'S')GO TO 4
GO TO 2
4 CALL SHORT(QQQ)
IF(JJ.GT.NK)RETURN
GO TO 1
2 IF(J.NE.21)GO TO 3
J=J+1
GO TO 1
3 JJ=JJ+1
IF(JJ.GT.NK)GO TO 4
CALL OPENIT(22,NZ(JJ),'SCR',0)
GO TO 1
END
SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE IN WORD J TO UPPER CASE.
J=J.AND..NOT.((J/2).AND."201004020100)
END